Trust in Artificial Intelligent Agents Scale

First quantitative approbation. Data analysis workflow

Anton Angelgardt https://www.hse.ru/en/staff/angelgardt (HSE University)https://www.hse.ru/en/
2021-05-08

Packages


library(tidyverse)
library(psych)
library(lavaan)
library(semPlot)
library(knitr)
library(corrplot)
theme_set(theme_bw())

Import data


taia <- read_csv("https://github.com/angelgardt/taia/raw/master/data/taia.csv")

Preparation

Vectors of TAIA items:


pr_items <- colnames(taia)[1:10]
co_items <- colnames(taia)[11:20]
ut_items <- colnames(taia)[21:32]
fa_items <- colnames(taia)[33:42]
de_items <- colnames(taia)[43:53]
un_items <- colnames(taia)[54:65]
taia_items <- colnames(taia)[1:65]

Vector of GT items:


gt_items <- colnames(taia)[66:71]

Column names for further formatting:


col_names <- c("", "Num. of obs.", "Mean", "SD",
               "Median", "Trimmed Mean", "MAD",
               "Min", "Max", "Range",
               "Skewness", "Kurtuosis", "SE")
total_colnames <- c("Alpha", "Standardized Alpha", "Guttman's Lambda 6",
                    "Average interitem correlation", "S/N",
                    "Alpha SE", "Scale Mean", "Total Score SD",
                    "Median interitem correlation")
item_stats_colnames <- c("Num. of Obs.", "Discrimination",
                         "Std Cor",
                         "Cor Overlap Corrected",
                         "Cor if drop",
                         "Difficulty", "SD")
alpha_drop <- c("Alpha", "Standardized Alpha",
                "Guttman's Lambda 6",   "Average interitem correlation",
                "S/N",  "Alpha SE", "Var(r)","Median interitem correlation")

Exploratory analysis

TAIA descriptive statistics


taia %>% 
  select(all_of(pr_items)) %>% 
  describe() %>% 
  kable(caption = "Predictability", label = 1, digits = 2, col.names = col_names)
Table 1: Predictability
Num. of obs. Mean SD Median Trimmed Mean MAD Min Max Range Skewness Kurtuosis SE
pr01 1 513 2.84 1.00 3 2.88 1.48 0 5 5 -0.32 0.44 0.04
pr02 2 513 2.75 0.98 3 2.79 1.48 0 5 5 -0.21 0.12 0.04
pr03 3 513 2.86 1.04 3 2.89 1.48 0 5 5 -0.16 -0.04 0.05
pr04 4 513 2.81 1.07 3 2.85 1.48 0 5 5 -0.19 -0.02 0.05
pr05 5 513 2.25 1.21 2 2.26 1.48 0 5 5 0.02 -0.32 0.05
pr06 6 513 3.05 1.08 3 3.07 1.48 0 5 5 -0.27 0.07 0.05
pr07 7 513 2.60 1.12 3 2.63 1.48 0 5 5 -0.17 -0.10 0.05
pr08 8 513 3.04 0.92 3 3.09 0.00 0 5 5 -0.55 1.25 0.04
pr09 9 513 2.91 0.97 3 2.95 0.00 0 5 5 -0.48 1.00 0.04
pr10 10 513 2.84 1.04 3 2.90 1.48 0 5 5 -0.41 0.31 0.05

taia %>% 
  select(all_of(co_items)) %>% 
  describe() %>% 
  kable(caption = "Consistency", label = 2, digits = 2, col.names = col_names)
Table 2: Consistency
Num. of obs. Mean SD Median Trimmed Mean MAD Min Max Range Skewness Kurtuosis SE
co01 1 513 2.51 1.09 3 2.53 1.48 0 5 5 -0.15 0.12 0.05
co02 2 513 2.52 1.06 3 2.54 1.48 0 5 5 -0.18 -0.04 0.05
co03 3 513 2.87 1.03 3 2.93 1.48 0 5 5 -0.38 0.33 0.05
co04 4 513 3.46 1.10 4 3.53 1.48 0 5 5 -0.57 0.32 0.05
co05 5 513 2.22 1.13 2 2.20 1.48 0 5 5 0.13 -0.17 0.05
co06 6 513 2.52 1.12 3 2.53 1.48 0 5 5 -0.12 -0.15 0.05
co07 7 513 1.60 1.14 2 1.54 1.48 0 5 5 0.53 0.09 0.05
co08 8 513 1.93 1.07 2 1.88 1.48 0 5 5 0.42 0.22 0.05
co09 9 513 2.08 1.09 2 2.03 1.48 0 5 5 0.34 0.09 0.05
co10 10 513 2.46 1.11 2 2.46 1.48 0 5 5 -0.04 -0.07 0.05

taia %>% 
  select(all_of(ut_items)) %>% 
  describe() %>% 
  kable(caption = "Utility", label = 3, digits = 2, col.names = col_names)
Table 3: Utility
Num. of obs. Mean SD Median Trimmed Mean MAD Min Max Range Skewness Kurtuosis SE
ut01 1 513 3.75 1.07 4 3.87 1.48 0 5 5 -0.87 1.08 0.05
ut02 2 513 3.52 1.06 3 3.58 1.48 0 5 5 -0.54 0.54 0.05
ut03 3 513 3.51 1.14 4 3.60 1.48 0 5 5 -0.57 0.06 0.05
ut04 4 513 3.10 1.12 3 3.15 1.48 0 5 5 -0.43 0.04 0.05
ut05 5 513 3.05 1.21 3 3.10 1.48 0 5 5 -0.34 -0.16 0.05
ut06 6 513 3.27 1.10 3 3.31 1.48 0 5 5 -0.61 0.64 0.05
ut07 7 513 3.20 1.13 3 3.22 1.48 0 5 5 -0.29 -0.19 0.05
ut08 8 513 3.43 1.06 3 3.48 1.48 0 5 5 -0.57 0.47 0.05
ut09 9 513 3.18 1.17 3 3.24 1.48 0 5 5 -0.48 0.17 0.05
ut10 10 513 2.17 1.12 2 2.15 1.48 0 5 5 0.09 -0.22 0.05
ut11 11 513 2.69 1.24 3 2.71 1.48 0 5 5 -0.13 -0.41 0.05
ut12 12 513 3.16 1.15 3 3.21 1.48 0 5 5 -0.43 0.05 0.05

taia %>% 
  select(all_of(fa_items)) %>% 
  describe() %>% 
  kable(caption = "Faith", label = 4, digits = 2, col.names = col_names)
Table 4: Faith
Num. of obs. Mean SD Median Trimmed Mean MAD Min Max Range Skewness Kurtuosis SE
fa01 1 513 2.44 1.11 2 2.44 1.48 0 5 5 -0.03 -0.27 0.05
fa02 2 513 2.16 1.18 2 2.14 1.48 0 5 5 0.16 -0.42 0.05
fa03 3 513 1.54 1.15 1 1.45 1.48 0 5 5 0.66 0.18 0.05
fa04 4 513 1.61 1.10 2 1.55 1.48 0 5 5 0.54 0.12 0.05
fa05 5 513 2.47 1.11 3 2.49 1.48 0 5 5 -0.13 -0.09 0.05
fa06 6 513 2.49 1.08 3 2.50 1.48 0 5 5 -0.17 0.07 0.05
fa07 7 513 2.36 1.08 2 2.36 1.48 0 5 5 -0.12 -0.15 0.05
fa08 8 513 2.20 1.14 2 2.16 1.48 0 5 5 0.26 -0.12 0.05
fa09 9 513 2.29 1.18 2 2.28 1.48 0 5 5 0.11 -0.41 0.05
fa10 10 513 2.64 1.20 3 2.62 1.48 0 5 5 0.06 -0.31 0.05

taia %>% 
  select(all_of(de_items)) %>% 
  describe() %>% 
  kable(caption = "Dependability", label = 5, digits = 2, col.names = col_names)
Table 5: Dependability
Num. of obs. Mean SD Median Trimmed Mean MAD Min Max Range Skewness Kurtuosis SE
de01 1 513 2.60 1.11 3 2.65 1.48 0 5 5 -0.41 0.07 0.05
de02 2 513 2.19 1.16 2 2.20 1.48 0 5 5 0.00 -0.33 0.05
de03 3 513 2.19 1.21 2 2.20 1.48 0 5 5 0.02 -0.31 0.05
de04 4 513 1.91 1.06 2 1.86 1.48 0 5 5 0.55 0.57 0.05
de05 5 513 3.53 1.18 4 3.64 1.48 0 5 5 -0.78 0.46 0.05
de06 6 513 2.23 1.23 2 2.25 1.48 0 5 5 0.00 -0.44 0.05
de07 7 513 2.82 1.02 3 2.86 1.48 0 5 5 -0.31 0.32 0.04
de08 8 513 2.64 1.05 3 2.69 1.48 0 5 5 -0.40 0.14 0.05
de09 9 513 3.42 1.21 4 3.51 1.48 0 5 5 -0.57 -0.22 0.05
de10 10 513 2.26 1.20 2 2.29 1.48 0 5 5 -0.21 -0.41 0.05
de11 11 513 2.32 1.20 2 2.32 1.48 0 5 5 0.00 -0.52 0.05

taia %>%
  select(all_of(un_items)) %>% 
  describe() %>% 
  kable(caption = "Understanding", label = 6, digits = 2, col.names = col_names)
Table 6: Understanding
Num. of obs. Mean SD Median Trimmed Mean MAD Min Max Range Skewness Kurtuosis SE
un01 1 513 2.95 1.06 3 3.02 1.48 0 5 5 -0.48 0.31 0.05
un02 2 513 2.49 1.14 3 2.51 1.48 0 5 5 -0.19 -0.25 0.05
un03 3 513 3.02 1.17 3 3.09 1.48 0 5 5 -0.54 0.02 0.05
un04 4 513 2.62 1.09 3 2.67 1.48 0 5 5 -0.33 -0.18 0.05
un05 5 513 2.83 1.11 3 2.90 1.48 0 5 5 -0.49 0.23 0.05
un06 6 513 2.28 1.23 2 2.25 1.48 0 5 5 0.20 -0.60 0.05
un07 7 513 2.16 1.19 2 2.17 1.48 0 5 5 -0.01 -0.52 0.05
un08 8 513 2.90 1.16 3 2.96 1.48 0 5 5 -0.44 0.02 0.05
un09 9 513 2.34 1.23 2 2.39 1.48 0 5 5 -0.19 -0.71 0.05
un10 10 513 2.27 1.16 2 2.26 1.48 0 5 5 0.05 -0.44 0.05
un11 11 513 2.63 1.20 3 2.67 1.48 0 5 5 -0.24 -0.36 0.05
un12 12 513 2.89 1.13 3 2.95 1.48 0 5 5 -0.43 0.10 0.05

TAIA scores distributions


taia %>% select(all_of(pr_items)) %>% 
  pivot_longer(cols = pr_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "darkred") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Predictability") +
  theme(plot.title = element_text(hjust = .5))


taia %>% select(all_of(co_items)) %>% 
  pivot_longer(cols = co_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "chocolate3") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Consistency") +
  theme(plot.title = element_text(hjust = .5))


taia %>% select(all_of(ut_items)) %>% 
  pivot_longer(cols = ut_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "goldenrod3") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Utility") +
  theme(plot.title = element_text(hjust = .5))


taia %>% select(all_of(fa_items)) %>% 
  pivot_longer(cols = fa_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "darkgreen") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Faith") +
  theme(plot.title = element_text(hjust = .5))


taia %>% select(all_of(de_items)) %>% 
  pivot_longer(cols = de_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "darkblue") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Dependability") +
  theme(plot.title = element_text(hjust = .5))


taia %>% select(all_of(un_items)) %>% 
  pivot_longer(cols = un_items) %>% 
  ggplot(aes(value)) +
  geom_bar(fill = "purple4") +
  facet_wrap(~ name) +
  scale_x_discrete(limits = factor(0:5)) +
  labs(x = "Score", y = "Number of observations",
       title = "Understanding") +
  theme(plot.title = element_text(hjust = .5))

Correlations

Predictability


corrplot.mixed(cor(taia %>% select(all_of(pr_items))),
               lower.col = "black")

Consistency


corrplot.mixed(cor(taia %>% select(all_of(co_items))),
               lower.col = "black")

Utility


corrplot.mixed(cor(taia %>% select(all_of(ut_items))),
               lower.col = "black")

Faith


corrplot.mixed(cor(taia %>% select(all_of(fa_items))),
               lower.col = "black")

Dependability


corrplot.mixed(cor(taia %>% select(all_of(de_items))),
               lower.col = "black")

Understanding


corrplot.mixed(cor(taia %>% select(all_of(un_items))),
               lower.col = "black")

All TAIA items correlations


qgraph::qgraph(
  cor(taia %>% select(all_of(taia_items))),
  layout = "spring",
  posCol = "darkgreen",
  negCol = "darkred"
)

Psychometric Analysis

Subscales

Predictability


pr1 <- psych::alpha(
  taia %>% select(all_of(pr_items)),
  cumulative = TRUE,
  title = "Predictability Factor",
  check.keys = FALSE
)

kable(pr1$total,
      caption = "Perdictability. Subscale statistics", 
      label = 7, digits = 2,
      col.names = total_colnames
      )
Table 7: Perdictability. Subscale statistics
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Scale Mean Total Score SD Median interitem correlation
0.8 0.8 0.82 0.29 4.1 0.01 27.95 6.25 0.36

pr1$item.stats$mean <- pr1$item.stats$mean / 5
kable(pr1$item.stats,
      caption = "Predictability. Items statistics",
      label = 8, digits = 2,
      col.names = item_stats_colnames)
Table 8: Predictability. Items statistics
Num. of Obs. Discrimination Std Cor Cor Overlap Corrected Cor if drop Difficulty SD
pr01 513 0.77 0.78 0.78 0.70 0.57 1.00
pr02 513 0.67 0.67 0.63 0.57 0.55 0.98
pr03 513 0.39 0.39 0.29 0.23 0.57 1.04
pr04 513 0.29 0.28 0.17 0.12 0.56 1.07
pr05 513 0.61 0.59 0.52 0.47 0.45 1.21
pr06 513 0.64 0.63 0.57 0.51 0.61 1.08
pr07 513 0.74 0.73 0.71 0.64 0.52 1.12
pr08 513 0.73 0.74 0.71 0.64 0.61 0.92
pr09 513 0.62 0.63 0.57 0.51 0.58 0.97
pr10 513 0.57 0.57 0.49 0.44 0.57 1.04

pr1$item.stats %>%
  ggplot(aes(x = row.names(pr1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Predictability. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))


kable(pr1$alpha.drop,
      caption = "Predictability. Subscale statistics when item drop",
      label = 9, digits = 2, col.names = alpha_drop)
Table 9: Predictability. Subscale statistics when item drop
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Var(r) Median interitem correlation
pr01 0.76 0.76 0.78 0.26 3.18 0.02 0.03 0.32
pr02 0.77 0.78 0.79 0.28 3.49 0.01 0.04 0.32
pr03 0.81 0.81 0.82 0.33 4.37 0.01 0.03 0.38
pr04 0.82 0.83 0.82 0.34 4.72 0.01 0.02 0.38
pr05 0.78 0.79 0.81 0.29 3.71 0.01 0.03 0.36
pr06 0.78 0.78 0.80 0.29 3.60 0.01 0.03 0.34
pr07 0.76 0.77 0.79 0.27 3.32 0.02 0.03 0.32
pr08 0.77 0.77 0.79 0.27 3.30 0.02 0.03 0.32
pr09 0.78 0.78 0.80 0.29 3.61 0.01 0.03 0.35
pr10 0.79 0.79 0.81 0.30 3.79 0.01 0.03 0.37

kable(pr1$response.freq,
      caption = "Predictability. Non missing response frequency for each item",
      label = 10, digits = 2)
Table 10: Predictability. Non missing response frequency for each item
0 1 2 3 4 5 miss
pr01 0.02 0.06 0.24 0.45 0.19 0.04 0
pr02 0.02 0.08 0.27 0.43 0.17 0.03 0
pr03 0.02 0.07 0.27 0.39 0.21 0.05 0
pr04 0.02 0.07 0.28 0.37 0.21 0.05 0
pr05 0.09 0.16 0.32 0.29 0.10 0.04 0
pr06 0.02 0.06 0.20 0.40 0.24 0.09 0
pr07 0.04 0.12 0.28 0.38 0.15 0.04 0
pr08 0.02 0.03 0.16 0.51 0.24 0.04 0
pr09 0.02 0.05 0.19 0.52 0.18 0.04 0
pr10 0.03 0.08 0.21 0.45 0.19 0.04 0

Consistency


co1 <- psych::alpha(
  taia %>% select(all_of(co_items)),
  cumulative = TRUE,
  title = "Consistency Factor",
  check.keys = FALSE
)

Some items ( co07 ) were negatively correlated with the total scale and 
probably should be reversed.  
To do this, run the function again with the 'check.keys=TRUE' option

kable(co1$total,
      caption = "Consistency. Subscale statistics", 
      label = 11, digits = 2,
      col.names = total_colnames)
Table 11: Consistency. Subscale statistics
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Scale Mean Total Score SD Median interitem correlation
0.77 0.78 0.81 0.26 3.48 0.01 24.18 6.28 0.3

co1$item.stats$mean <- co1$item.stats$mean / 5
kable(co1$item.stats,
      caption = "Consistency. Items statistics",
      label = 12, digits = 2,
      col.names = item_stats_colnames)
Table 12: Consistency. Items statistics
Num. of Obs. Discrimination Std Cor Cor Overlap Corrected Cor if drop Difficulty SD
co01 513 0.75 0.75 0.73 0.66 0.50 1.09
co02 513 0.69 0.70 0.67 0.59 0.50 1.06
co03 513 0.56 0.57 0.49 0.43 0.57 1.03
co04 513 0.42 0.42 0.33 0.26 0.69 1.10
co05 513 0.79 0.79 0.79 0.71 0.44 1.13
co06 513 0.66 0.66 0.62 0.54 0.50 1.12
co07 513 -0.07 -0.08 -0.25 -0.25 0.32 1.14
co08 513 0.49 0.49 0.40 0.34 0.39 1.07
co09 513 0.78 0.78 0.78 0.69 0.42 1.09
co10 513 0.69 0.69 0.64 0.58 0.49 1.11

co1$item.stats %>%
  ggplot(aes(x = row.names(co1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Consistency. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))


kable(co1$alpha.drop,
      caption = "Consistency. Subscale statistics when item drop",
      label = 13, digits = 2,
      col.names = alpha_drop)
Table 13: Consistency. Subscale statistics when item drop
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Var(r) Median interitem correlation
co01 0.72 0.73 0.77 0.23 2.68 0.02 0.07 0.28
co02 0.74 0.74 0.78 0.24 2.82 0.02 0.07 0.29
co03 0.76 0.76 0.80 0.26 3.15 0.02 0.07 0.29
co04 0.78 0.78 0.81 0.28 3.55 0.01 0.07 0.37
co05 0.72 0.72 0.76 0.22 2.59 0.02 0.06 0.28
co06 0.74 0.74 0.79 0.24 2.91 0.02 0.07 0.29
co07 0.84 0.84 0.85 0.36 5.13 0.01 0.02 0.39
co08 0.77 0.77 0.80 0.27 3.36 0.01 0.07 0.35
co09 0.72 0.72 0.76 0.23 2.62 0.02 0.07 0.28
co10 0.74 0.74 0.78 0.24 2.84 0.02 0.07 0.28

kable(co1$response.freq,
      caption = "Consistency. Non missing response frequency for each item",
      label = 14, digits = 2)
Table 14: Consistency. Non missing response frequency for each item
0 1 2 3 4 5 miss
co01 0.05 0.11 0.31 0.39 0.11 0.04 0
co02 0.04 0.12 0.32 0.37 0.13 0.02 0
co03 0.02 0.07 0.22 0.44 0.20 0.04 0
co04 0.01 0.04 0.11 0.34 0.32 0.18 0
co05 0.06 0.19 0.36 0.27 0.09 0.03 0
co06 0.04 0.14 0.28 0.38 0.12 0.04 0
co07 0.18 0.31 0.32 0.14 0.04 0.02 0
co08 0.08 0.26 0.42 0.17 0.06 0.02 0
co09 0.06 0.24 0.39 0.23 0.06 0.03 0
co10 0.04 0.13 0.33 0.34 0.12 0.04 0

Utility


ut1 <- psych::alpha(
  taia %>% select(all_of(ut_items)),
  cumulative = TRUE,
  title = "Utility Factor",
  check.keys = FALSE
)

Some items ( ut10 ) were negatively correlated with the total scale and 
probably should be reversed.  
To do this, run the function again with the 'check.keys=TRUE' option

kable(ut1$total,
      caption = "Utility. Subscale statistics", 
      label = 15, digits = 2,
      col.names = total_colnames)
Table 15: Utility. Subscale statistics
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Scale Mean Total Score SD Median interitem correlation
0.86 0.86 0.88 0.34 6.21 0.01 38.03 8.52 0.39

ut1$item.stats$mean <- ut1$item.stats$mean / 5
kable(ut1$item.stats,
      caption = "Utility. Items statistics",
      label = 16, digits = 2,
      col.names = item_stats_colnames)
Table 16: Utility. Items statistics
Num. of Obs. Discrimination Std Cor Cor Overlap Corrected Cor if drop Difficulty SD
ut01 513 0.78 0.78 0.78 0.72 0.75 1.07
ut02 513 0.83 0.83 0.84 0.78 0.70 1.06
ut03 513 0.52 0.52 0.46 0.42 0.70 1.14
ut04 513 0.53 0.53 0.46 0.43 0.62 1.12
ut05 513 0.70 0.70 0.66 0.62 0.61 1.21
ut06 513 0.77 0.77 0.76 0.71 0.65 1.10
ut07 513 0.64 0.64 0.60 0.55 0.64 1.13
ut08 513 0.67 0.67 0.64 0.59 0.69 1.06
ut09 513 0.69 0.69 0.66 0.61 0.64 1.17
ut10 513 0.13 0.14 0.02 0.00 0.43 1.12
ut11 513 0.57 0.56 0.49 0.46 0.54 1.24
ut12 513 0.72 0.72 0.69 0.65 0.63 1.15

ut1$item.stats %>%
  ggplot(aes(x = row.names(ut1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Utility. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))


kable(ut1$alpha.drop,
      caption = "Utility. Subscale statistics when item drop",
      label = 17, digits = 2,
      col.names = alpha_drop)
Table 17: Utility. Subscale statistics when item drop
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Var(r) Median interitem correlation
ut01 0.84 0.84 0.85 0.32 5.18 0.01 0.04 0.33
ut02 0.83 0.83 0.85 0.31 5.02 0.01 0.03 0.33
ut03 0.86 0.86 0.87 0.36 6.07 0.01 0.04 0.42
ut04 0.86 0.86 0.87 0.35 6.04 0.01 0.04 0.42
ut05 0.84 0.85 0.86 0.33 5.46 0.01 0.04 0.39
ut06 0.84 0.84 0.86 0.32 5.22 0.01 0.04 0.33
ut07 0.85 0.85 0.86 0.34 5.66 0.01 0.04 0.39
ut08 0.85 0.85 0.86 0.33 5.54 0.01 0.04 0.39
ut09 0.84 0.85 0.86 0.33 5.49 0.01 0.04 0.39
ut10 0.88 0.88 0.89 0.41 7.61 0.01 0.02 0.42
ut11 0.85 0.86 0.87 0.35 5.94 0.01 0.04 0.42
ut12 0.84 0.84 0.86 0.33 5.38 0.01 0.04 0.37

kable(ut1$response.freq,
      caption = "Utility. Non missing response frequency for each item",
      label = 18, digits = 2)
Table 18: Utility. Non missing response frequency for each item
0 1 2 3 4 5 miss
ut01 0.02 0.02 0.06 0.29 0.34 0.27 0
ut02 0.01 0.02 0.09 0.38 0.30 0.20 0
ut03 0.01 0.04 0.10 0.32 0.30 0.22 0
ut04 0.02 0.08 0.15 0.40 0.27 0.09 0
ut05 0.03 0.06 0.21 0.34 0.23 0.12 0
ut06 0.03 0.03 0.14 0.38 0.30 0.12 0
ut07 0.02 0.05 0.19 0.35 0.27 0.13 0
ut08 0.01 0.03 0.12 0.35 0.34 0.15 0
ut09 0.03 0.05 0.15 0.38 0.26 0.13 0
ut10 0.07 0.19 0.37 0.26 0.09 0.02 0
ut11 0.05 0.12 0.27 0.31 0.19 0.07 0
ut12 0.02 0.06 0.15 0.38 0.26 0.12 0

Faith


fa1 <- psych::alpha(
  taia %>% select(all_of(fa_items)),
  cumulative = TRUE,
  title = "Faith Factor",
  check.keys = FALSE
)

kable(fa1$total,
      caption = "Faith. Subscale statistics", 
      label = 19, digits = 2,
      col.names = total_colnames)
Table 19: Faith. Subscale statistics
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Scale Mean Total Score SD Median interitem correlation
0.76 0.76 0.81 0.24 3.12 0.02 22.18 6.36 0.25

fa1$item.stats$mean <- fa1$item.stats$mean / 5
kable(fa1$item.stats,
      caption = "Faith. Items statistics",
      label = 20, digits = 2,
      col.names = item_stats_colnames)
Table 20: Faith. Items statistics
Num. of Obs. Discrimination Std Cor Cor Overlap Corrected Cor if drop Difficulty SD
fa01 513 0.76 0.76 0.77 0.67 0.49 1.11
fa02 513 0.59 0.58 0.54 0.45 0.43 1.18
fa03 513 0.29 0.29 0.17 0.11 0.31 1.15
fa04 513 0.42 0.43 0.34 0.26 0.32 1.10
fa05 513 0.77 0.77 0.78 0.68 0.49 1.11
fa06 513 0.55 0.57 0.51 0.42 0.50 1.08
fa07 513 0.40 0.40 0.29 0.24 0.47 1.08
fa08 513 0.56 0.56 0.50 0.42 0.44 1.14
fa09 513 0.63 0.62 0.59 0.50 0.46 1.18
fa10 513 0.63 0.62 0.57 0.50 0.53 1.20

fa1$item.stats %>%
  ggplot(aes(x = row.names(fa1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Faith. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))


kable(fa1$alpha.drop,
      caption = "Faith. Subscale statistics when item drop",
      label = 21, digits = 2,
      col.names = alpha_drop)
Table 21: Faith. Subscale statistics when item drop
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Var(r) Median interitem correlation
fa01 0.70 0.70 0.76 0.21 2.34 0.02 0.04 0.23
fa02 0.73 0.73 0.78 0.23 2.76 0.02 0.04 0.25
fa03 0.78 0.78 0.82 0.28 3.50 0.01 0.04 0.29
fa04 0.76 0.76 0.80 0.26 3.13 0.02 0.05 0.25
fa05 0.70 0.70 0.76 0.20 2.31 0.02 0.04 0.23
fa06 0.74 0.74 0.79 0.24 2.79 0.02 0.05 0.27
fa07 0.76 0.76 0.81 0.26 3.19 0.02 0.05 0.29
fa08 0.74 0.74 0.79 0.24 2.82 0.02 0.04 0.25
fa09 0.73 0.73 0.78 0.23 2.66 0.02 0.04 0.24
fa10 0.73 0.73 0.79 0.23 2.65 0.02 0.05 0.24

kable(fa1$response.freq,
      caption = "Faith. Non missing response frequency for each item",
      label = 22, digits = 2)
Table 22: Faith. Non missing response frequency for each item
0 1 2 3 4 5 miss
fa01 0.04 0.16 0.31 0.34 0.12 0.03 0
fa02 0.08 0.20 0.36 0.21 0.12 0.02 0
fa03 0.19 0.34 0.30 0.11 0.05 0.02 0
fa04 0.15 0.34 0.33 0.13 0.04 0.01 0
fa05 0.05 0.12 0.33 0.34 0.13 0.03 0
fa06 0.05 0.12 0.31 0.38 0.11 0.03 0
fa07 0.05 0.15 0.33 0.34 0.11 0.02 0
fa08 0.06 0.20 0.38 0.24 0.09 0.03 0
fa09 0.06 0.19 0.34 0.26 0.13 0.03 0
fa10 0.04 0.12 0.31 0.31 0.14 0.08 0

Dependability


de1 <- psych::alpha(
  taia %>% select(all_of(de_items)),
  cumulative = TRUE,
  title = "Dependability Factor",
  check.keys = FALSE
)

Some items ( de04 ) were negatively correlated with the total scale and 
probably should be reversed.  
To do this, run the function again with the 'check.keys=TRUE' option

kable(de1$total,
      caption = "Dependability. Subscale statistics", 
      label = 23, digits = 2,
      col.names = total_colnames)
Table 23: Dependability. Subscale statistics
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Scale Mean Total Score SD Median interitem correlation
0.74 0.74 0.79 0.2 2.82 0.02 28.11 6.7 0.24

de1$item.stats$mean <- de1$item.stats$mean / 5
kable(de1$item.stats,
      caption = "Dependability. Items statistics",
      label = 24, digits = 2,
      col.names = item_stats_colnames)
Table 24: Dependability. Items statistics
Num. of Obs. Discrimination Std Cor Cor Overlap Corrected Cor if drop Difficulty SD
de01 513 0.58 0.59 0.53 0.45 0.52 1.11
de02 513 0.72 0.72 0.70 0.62 0.44 1.16
de03 513 0.66 0.65 0.61 0.53 0.44 1.21
de04 513 -0.24 -0.24 -0.41 -0.38 0.38 1.06
de05 513 0.58 0.57 0.55 0.44 0.71 1.18
de06 513 0.67 0.66 0.62 0.55 0.45 1.23
de07 513 0.58 0.60 0.54 0.47 0.56 1.02
de08 513 0.67 0.68 0.65 0.57 0.53 1.05
de09 513 0.44 0.43 0.37 0.27 0.68 1.21
de10 513 0.73 0.73 0.72 0.63 0.45 1.20
de11 513 0.40 0.39 0.27 0.23 0.46 1.20

de1$item.stats %>%
  ggplot(aes(x = row.names(de1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Dependability. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))


kable(de1$alpha.drop,
      caption = "Dependability. Subscale statistics when item drop",
      label = 25, digits = 2,
      col.names = alpha_drop)
Table 25: Dependability. Subscale statistics when item drop
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Var(r) Median interitem correlation
de01 0.72 0.71 0.77 0.20 2.44 0.02 0.07 0.21
de02 0.69 0.69 0.75 0.18 2.19 0.02 0.07 0.21
de03 0.70 0.70 0.76 0.19 2.31 0.02 0.07 0.21
de04 0.81 0.81 0.83 0.30 4.33 0.01 0.02 0.31
de05 0.72 0.71 0.75 0.20 2.47 0.02 0.07 0.20
de06 0.70 0.70 0.76 0.19 2.30 0.02 0.07 0.21
de07 0.72 0.71 0.77 0.19 2.42 0.02 0.07 0.21
de08 0.70 0.69 0.76 0.18 2.26 0.02 0.06 0.21
de09 0.74 0.73 0.77 0.22 2.77 0.02 0.07 0.29
de10 0.69 0.68 0.75 0.18 2.16 0.02 0.07 0.21
de11 0.75 0.74 0.80 0.22 2.85 0.02 0.08 0.31

kable(de1$response.freq,
      caption = "Dependability. Non missing response frequency for each item",
      label = 26, digits = 2)
Table 26: Dependability. Non missing response frequency for each item
0 1 2 3 4 5 miss
de01 0.05 0.10 0.25 0.42 0.15 0.03 0
de02 0.09 0.17 0.36 0.26 0.11 0.02 0
de03 0.10 0.16 0.34 0.28 0.09 0.03 0
de04 0.07 0.26 0.44 0.14 0.05 0.02 0
de05 0.02 0.04 0.10 0.28 0.33 0.22 0
de06 0.10 0.17 0.32 0.28 0.11 0.03 0
de07 0.03 0.05 0.27 0.41 0.20 0.04 0
de08 0.04 0.10 0.25 0.44 0.15 0.03 0
de09 0.01 0.06 0.13 0.27 0.32 0.20 0
de10 0.10 0.14 0.29 0.34 0.10 0.02 0
de11 0.07 0.20 0.28 0.30 0.12 0.03 0

Understanding


un1 <- psych::alpha(
  taia %>% select(all_of(un_items)),
  cumulative = TRUE,
  title = "Understanding Factor",
  check.keys = FALSE
)

kable(un1$total,
      caption = "Understanding. Subscale statistics", 
      label = 27, digits = 2,
      col.names = total_colnames)
Table 27: Understanding. Subscale statistics
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Scale Mean Total Score SD Median interitem correlation
0.92 0.92 0.92 0.5 12.04 0.01 31.37 10.2 0.52

un1$item.stats$mean <- un1$item.stats$mean / 5
kable(un1$item.stats,
      caption = "Understanding. Items statistics",
      label = 28, digits = 2,
      col.names = item_stats_colnames)
Table 28: Understanding. Items statistics
Num. of Obs. Discrimination Std Cor Cor Overlap Corrected Cor if drop Difficulty SD
un01 513 0.76 0.76 0.74 0.71 0.59 1.06
un02 513 0.84 0.84 0.84 0.80 0.50 1.14
un03 513 0.60 0.60 0.54 0.52 0.60 1.17
un04 513 0.77 0.77 0.75 0.72 0.52 1.09
un05 513 0.81 0.81 0.80 0.77 0.57 1.11
un06 513 0.51 0.51 0.44 0.42 0.46 1.23
un07 513 0.73 0.73 0.70 0.67 0.43 1.19
un08 513 0.77 0.77 0.75 0.72 0.58 1.16
un09 513 0.74 0.73 0.70 0.68 0.47 1.23
un10 513 0.75 0.75 0.73 0.70 0.45 1.16
un11 513 0.79 0.79 0.77 0.74 0.53 1.20
un12 513 0.76 0.76 0.74 0.70 0.58 1.13

un1$item.stats %>%
  ggplot(aes(x = row.names(un1$item.stats))) +
  geom_point(aes(y = mean), color = "darkblue", size = 3) +
  geom_point(aes(y = raw.r), color = "darkred", size = 2) +
  geom_hline(yintercept = 0.05, color = "darkblue") +
  geom_hline(yintercept = 0.95, color = "darkblue") +
  geom_hline(yintercept = 0.2, color = "darkred") +
  geom_hline(yintercept = 0, color = "black") +
  labs(x = "Item", y = "Value",
       title = "Understanding. Items characteristics",
       subtitle = "Difficulty (blue) and Dicrimination (red)") +
  theme(plot.title = element_text(hjust = .5),
        plot.subtitle = element_text(hjust = .5))


kable(un1$alpha.drop,
      caption = "Understanding. Subscale statistics when item drop",
      label = 29, digits = 2,
      col.names = alpha_drop)
Table 29: Understanding. Subscale statistics when item drop
Alpha Standardized Alpha Guttman’s Lambda 6 Average interitem correlation S/N Alpha SE Var(r) Median interitem correlation
un01 0.91 0.92 0.92 0.50 10.86 0.01 0.01 0.52
un02 0.91 0.91 0.91 0.48 10.31 0.01 0.01 0.51
un03 0.92 0.92 0.92 0.52 12.04 0.01 0.01 0.55
un04 0.91 0.92 0.92 0.50 10.80 0.01 0.01 0.52
un05 0.91 0.91 0.91 0.49 10.50 0.01 0.01 0.52
un06 0.93 0.93 0.93 0.54 12.78 0.00 0.01 0.55
un07 0.92 0.92 0.92 0.50 11.09 0.01 0.01 0.52
un08 0.91 0.92 0.91 0.50 10.79 0.01 0.01 0.52
un09 0.92 0.92 0.92 0.50 11.05 0.01 0.01 0.52
un10 0.91 0.92 0.92 0.50 10.92 0.01 0.01 0.52
un11 0.91 0.91 0.91 0.49 10.65 0.01 0.01 0.51
un12 0.91 0.92 0.92 0.50 10.86 0.01 0.01 0.52

kable(un1$response.freq,
      caption = "Understanding. Non missing response frequency for each item",
      label = 30, digits = 2)
Table 30: Understanding. Non missing response frequency for each item
0 1 2 3 4 5 miss
un01 0.03 0.07 0.19 0.42 0.24 0.05 0
un02 0.05 0.13 0.29 0.35 0.14 0.03 0
un03 0.03 0.08 0.16 0.36 0.28 0.08 0
un04 0.04 0.13 0.24 0.41 0.17 0.03 0
un05 0.04 0.08 0.19 0.43 0.21 0.05 0
un06 0.06 0.24 0.29 0.25 0.13 0.04 0
un07 0.09 0.20 0.30 0.29 0.10 0.02 0
un08 0.04 0.08 0.19 0.40 0.23 0.07 0
un09 0.08 0.18 0.25 0.31 0.16 0.02 0
un10 0.06 0.19 0.33 0.27 0.12 0.02 0
un11 0.05 0.13 0.24 0.35 0.18 0.05 0
un12 0.04 0.08 0.20 0.40 0.23 0.06 0

Items exclusion

Exploratory Factor Analysis

6 factors, varimax rotation

efa_6f_vm <- factanal(taia %>% select(all_of(taia_items)),
                   factors = 6,
                   scores = "regression",
                   rotation = "varimax")

loadings(efa_6f_vm)

Loadings:
     Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
pr01  0.511   0.438   0.167           0.268         
pr02  0.330   0.376   0.233                   0.173 
pr03  0.177                   0.110   0.612         
pr04         -0.150           0.134   0.440         
pr05  0.227   0.384   0.156   0.108           0.653 
pr06  0.518   0.260   0.150                   0.113 
pr07  0.417   0.511                   0.193   0.126 
pr08  0.550   0.383   0.135           0.192         
pr09  0.406   0.322   0.150           0.136         
pr10  0.376   0.284   0.137                         
co01  0.283   0.663                                 
co02  0.229   0.614   0.120                         
co03  0.465   0.344                   0.119   0.138 
co04  0.577   0.110   0.127           0.103         
co05  0.190   0.705                  -0.109         
co06  0.217   0.531          -0.140                 
co07 -0.357  -0.104  -0.101   0.117           0.128 
co08          0.450          -0.145  -0.454         
co09  0.132   0.676                  -0.174         
co10  0.228   0.518   0.211          -0.152         
ut01  0.810                                         
ut02  0.803           0.105           0.112   0.140 
ut03  0.419  -0.154           0.128   0.570         
ut04  0.485                   0.114           0.145 
ut05  0.606   0.181                           0.105 
ut06  0.731   0.139                           0.133 
ut07  0.565   0.188                                 
ut08  0.609   0.212                                 
ut09  0.613   0.151                           0.148 
ut10                 -0.118           0.259         
ut11  0.392   0.267   0.174                   0.577 
ut12  0.625   0.193   0.137           0.125         
fa01  0.251   0.368           0.640                 
fa02                 -0.192   0.628   0.111         
fa03 -0.101   0.438                  -0.306   0.115 
fa04          0.582                  -0.133   0.123 
fa05  0.251   0.429           0.621                 
fa06  0.281   0.580   0.111   0.207   0.221         
fa07                          0.174   0.489   0.182 
fa08                 -0.180   0.580   0.190   0.120 
fa09                 -0.130   0.589   0.247   0.110 
fa10  0.251   0.134           0.611                 
de01  0.303   0.422   0.158                         
de02  0.261   0.570   0.138           0.173   0.191 
de03  0.216   0.500   0.117   0.149           0.186 
de04 -0.462  -0.154  -0.147                         
de05  0.558   0.118   0.132           0.329         
de06  0.218   0.361   0.181   0.190   0.135   0.610 
de07  0.463   0.285   0.216           0.110   0.149 
de08  0.365   0.389   0.184   0.123   0.201   0.182 
de09  0.285                           0.558         
de10  0.287   0.508           0.176   0.110   0.312 
de11                          0.179   0.351   0.236 
un01  0.316           0.727                         
un02          0.148   0.807                         
un03  0.235           0.501  -0.241                 
un04  0.137   0.125   0.712                         
un05  0.225           0.783                         
un06 -0.151           0.488           0.243         
un07          0.310   0.646          -0.140   0.115 
un08  0.227           0.744                         
un09          0.182   0.664                   0.181 
un10          0.277   0.690  -0.114  -0.100         
un11                  0.757                         
un12  0.277           0.709                         

               Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
SS loadings      8.708   7.011   6.516   2.794   2.782   1.803
Proportion Var   0.134   0.108   0.100   0.043   0.043   0.028
Cumulative Var   0.134   0.242   0.342   0.385   0.428   0.456

kable(sort(efa_6f_vm$uniquenesses, decreasing = TRUE), col.names = "U")
U
ut10 0.9073192
co07 0.8183857
de11 0.7822050
pr04 0.7591429
pr10 0.7435298
de04 0.7386776
ut04 0.7276062
de01 0.6927754
fa07 0.6896196
fa03 0.6893869
pr09 0.6867794
un06 0.6754405
pr02 0.6569559
ut07 0.6412519
co06 0.6409573
un03 0.6324479
de03 0.6312699
pr06 0.6270480
de07 0.6223023
co04 0.6192165
co03 0.6178353
fa04 0.6107644
co10 0.6080403
de09 0.6057377
de08 0.5934608
ut05 0.5796609
pr03 0.5755150
ut08 0.5742453
fa08 0.5702292
ut09 0.5690733
fa09 0.5635590
co08 0.5522230
de05 0.5493456
co02 0.5476391
fa10 0.5387218
fa02 0.5357916
ut12 0.5316183
de10 0.5162880
de02 0.5152999
pr07 0.4950670
pr08 0.4938099
co09 0.4888758
un09 0.4762922
fa06 0.4723240
co01 0.4635556
ut03 0.4558692
co05 0.4538278
un04 0.4458240
un07 0.4442298
pr01 0.4373561
ut06 0.4224545
un10 0.4212091
un12 0.4164551
ut11 0.3975327
un11 0.3965605
un08 0.3900697
fa01 0.3826694
un01 0.3632078
de06 0.3629276
fa05 0.3610612
ut01 0.3310036
pr05 0.3296280
un05 0.3281390
un02 0.3133867
ut02 0.3056410
6 factors, promax rotation

efa_6f_pm <- factanal(taia %>% select(all_of(taia_items)),
                   factors = 6,
                   scores = "regression",
                   rotation = "promax")

loadings(efa_6f_pm)

Loadings:
     Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
pr01  0.433   0.255           0.272                 
pr02  0.303   0.156   0.127                   0.147 
pr03                 -0.117   0.688                 
pr04 -0.170                   0.483                 
pr05  0.108   0.120                           0.747 
pr06  0.150   0.468                                 
pr07  0.513   0.170           0.173                 
pr08  0.362   0.367           0.192                 
pr09  0.307   0.242           0.131                 
pr10  0.232   0.276                  -0.106         
co01  0.777                                  -0.113 
co02  0.729                                  -0.124 
co03  0.268   0.342                           0.103 
co04          0.557                          -0.116 
co05  0.848          -0.100  -0.107                 
co06  0.629                          -0.164         
co07 -0.105  -0.361                           0.173 
co08  0.560          -0.174  -0.487                 
co09  0.793          -0.112  -0.190                 
co10  0.567           0.113  -0.158                 
ut01 -0.260   0.957                                 
ut02 -0.236   0.905                           0.137 
ut03 -0.204   0.330  -0.103   0.613                 
ut04 -0.199   0.596          -0.113           0.162 
ut05          0.645                                 
ut06          0.803                           0.124 
ut07  0.113   0.587                                 
ut08  0.140   0.583                                 
ut09          0.643                           0.144 
ut10  0.127  -0.199  -0.168   0.307  -0.102         
ut11          0.357                           0.664 
ut12          0.585                                 
fa01  0.345           0.115           0.674         
fa02 -0.119                           0.642         
fa03  0.487  -0.183          -0.364           0.115 
fa04  0.680  -0.308          -0.166                 
fa05  0.437                           0.657         
fa06  0.639                   0.211   0.154         
fa07         -0.141           0.496           0.170 
fa08 -0.111  -0.117                   0.568   0.112 
fa09                          0.159   0.570         
fa10          0.228          -0.104   0.673  -0.136 
de01  0.455   0.101                                 
de02  0.585                   0.152           0.140 
de03  0.482                           0.110   0.150 
de04         -0.429                                 
de05          0.438           0.355                 
de06                                          0.688 
de07  0.172   0.348   0.105                   0.123 
de08  0.321   0.151           0.161           0.142 
de09                          0.642  -0.106         
de10  0.433                                   0.300 
de11         -0.101           0.319           0.250 
un01 -0.160   0.219   0.805           0.138  -0.112 
un02         -0.118   0.860                         
un03          0.141   0.458          -0.237         
un04                  0.743                         
un05                  0.845                         
un06         -0.387   0.539   0.320                 
un07  0.223  -0.138   0.644  -0.154           0.101 
un08 -0.151   0.118   0.824           0.123         
un09                  0.658                   0.191 
un10  0.225  -0.214   0.703                         
un11                  0.804                         
un12 -0.195   0.187   0.746                         

               Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
SS loadings      7.517   7.235   6.633   3.061   2.736   2.155
Proportion Var   0.116   0.111   0.102   0.047   0.042   0.033
Cumulative Var   0.116   0.227   0.329   0.376   0.418   0.451

kable(sort(efa_6f_pm$uniquenesses, decreasing = TRUE), col.names = "U")
U
ut10 0.9073192
co07 0.8183857
de11 0.7822050
pr04 0.7591429
pr10 0.7435298
de04 0.7386776
ut04 0.7276062
de01 0.6927754
fa07 0.6896196
fa03 0.6893869
pr09 0.6867794
un06 0.6754405
pr02 0.6569559
ut07 0.6412519
co06 0.6409573
un03 0.6324479
de03 0.6312699
pr06 0.6270480
de07 0.6223023
co04 0.6192165
co03 0.6178353
fa04 0.6107644
co10 0.6080403
de09 0.6057377
de08 0.5934608
ut05 0.5796609
pr03 0.5755150
ut08 0.5742453
fa08 0.5702292
ut09 0.5690733
fa09 0.5635590
co08 0.5522230
de05 0.5493456
co02 0.5476391
fa10 0.5387218
fa02 0.5357916
ut12 0.5316183
de10 0.5162880
de02 0.5152999
pr07 0.4950670
pr08 0.4938099
co09 0.4888758
un09 0.4762922
fa06 0.4723240
co01 0.4635556
ut03 0.4558692
co05 0.4538278
un04 0.4458240
un07 0.4442298
pr01 0.4373561
ut06 0.4224545
un10 0.4212091
un12 0.4164551
ut11 0.3975327
un11 0.3965605
un08 0.3900697
fa01 0.3826694
un01 0.3632078
de06 0.3629276
fa05 0.3610612
ut01 0.3310036
pr05 0.3296280
un05 0.3281390
un02 0.3133867
ut02 0.3056410

Confirmatory Factor Analysis

Model:

mdl1 <- "
PR =~ pr01 + pr02 + pr03 + pr04 + pr05 + pr06 + pr07 + pr08 + pr09 + pr10
CO =~ co01 + co02 + co03 + co04 + co05 + co06 + co07 + co08 + co09 + co10
UT =~ ut01 + ut02 + ut03 + ut04 + ut05 + ut06 + ut07 + ut08 + ut09 + ut10 + ut11 + ut12
FA =~ fa01 + fa02 + fa03 + fa04 + fa05 + fa06 + fa07 + fa08 + fa09 + fa10
DE =~ de01 + de02 + de03 + de04 + de05 + de06 + de07 + de08 + de09 + de10 + de11
UN =~ un01 + un02 + un03 + un04 + un05 + un06 + un07 + un08 + un09 + un10 + un11 + un12
"

CFA model fitting:


model1 <- cfa(mdl1, taia %>% select(all_of(taia_items)))

Fit measures:


kable(
  tibble(Measure = c("Chi-Squared", "DF", "p", "GFI", "AGFI", "CFI", "TLI", "SRMR", "RMSEA"),
               Value = round(
                 fitmeasures(model1, c("chisq", "df", "pvalue", "gfi", "agfi", "cfi", "tli", "srmr", "rmsea")), 4)
    )
)
Measure Value
Chi-Squared 7107.8205
DF 2000.0000
p 0.0000
GFI 0.6218
AGFI 0.5943
CFI 0.6975
TLI 0.6854
SRMR 0.0997
RMSEA 0.0706
Standardized solution:

smodel1 <- standardizedsolution(model1)

Loadings:


kable(
  smodel1 %>% 
    filter(op == "=~") %>% 
    mutate_at(vars(4:9), function(x) round(x, 3)),
  col.names = c("Factor", "", "Item", "Loading", "SE", "z", "p", "CI lower bound", "CI upper bound")
)
Factor Item Loading SE z p CI lower bound CI upper bound
PR =~ pr01 0.767 0.021 37.025 0.000 0.727 0.808
PR =~ pr02 0.602 0.030 19.788 0.000 0.542 0.661
PR =~ pr03 0.207 0.044 4.682 0.000 0.121 0.294
PR =~ pr04 0.062 0.046 1.349 0.177 -0.028 0.152
PR =~ pr05 0.575 0.032 18.138 0.000 0.513 0.638
PR =~ pr06 0.606 0.030 20.070 0.000 0.547 0.665
PR =~ pr07 0.729 0.023 31.541 0.000 0.684 0.774
PR =~ pr08 0.730 0.023 31.634 0.000 0.685 0.775
PR =~ pr09 0.598 0.031 19.577 0.000 0.538 0.658
PR =~ pr10 0.520 0.034 15.114 0.000 0.452 0.587
CO =~ co01 0.743 0.023 32.138 0.000 0.698 0.789
CO =~ co02 0.702 0.026 27.452 0.000 0.652 0.753
CO =~ co03 0.523 0.035 14.936 0.000 0.454 0.591
CO =~ co04 0.368 0.041 8.982 0.000 0.288 0.448
CO =~ co05 0.779 0.021 37.209 0.000 0.738 0.820
CO =~ co06 0.628 0.030 21.072 0.000 0.569 0.686
CO =~ co07 -0.248 0.044 -5.620 0.000 -0.335 -0.162
CO =~ co08 0.373 0.041 9.152 0.000 0.293 0.453
CO =~ co09 0.738 0.023 31.430 0.000 0.692 0.784
CO =~ co10 0.626 0.030 20.974 0.000 0.568 0.685
UT =~ ut01 0.774 0.020 38.677 0.000 0.735 0.814
UT =~ ut02 0.838 0.016 52.962 0.000 0.807 0.869
UT =~ ut03 0.431 0.038 11.352 0.000 0.356 0.505
UT =~ ut04 0.489 0.036 13.755 0.000 0.420 0.559
UT =~ ut05 0.662 0.027 24.620 0.000 0.610 0.715
UT =~ ut06 0.762 0.021 36.557 0.000 0.721 0.803
UT =~ ut07 0.583 0.031 18.659 0.000 0.521 0.644
UT =~ ut08 0.645 0.028 23.086 0.000 0.590 0.699
UT =~ ut09 0.672 0.026 25.455 0.000 0.620 0.723
UT =~ ut10 -0.016 0.046 -0.338 0.735 -0.106 0.075
UT =~ ut11 0.532 0.034 15.802 0.000 0.466 0.598
UT =~ ut12 0.702 0.025 28.542 0.000 0.654 0.750
FA =~ fa01 0.826 0.019 43.688 0.000 0.789 0.863
FA =~ fa02 0.360 0.041 8.678 0.000 0.278 0.441
FA =~ fa03 0.207 0.045 4.581 0.000 0.118 0.296
FA =~ fa04 0.380 0.041 9.330 0.000 0.301 0.460
FA =~ fa05 0.850 0.018 48.152 0.000 0.815 0.884
FA =~ fa06 0.619 0.031 20.287 0.000 0.560 0.679
FA =~ fa07 0.238 0.045 5.325 0.000 0.150 0.325
FA =~ fa08 0.343 0.042 8.168 0.000 0.260 0.425
FA =~ fa09 0.420 0.039 10.650 0.000 0.342 0.497
FA =~ fa10 0.589 0.032 18.368 0.000 0.526 0.652
DE =~ de01 0.578 0.032 18.128 0.000 0.515 0.640
DE =~ de02 0.701 0.025 27.887 0.000 0.652 0.750
DE =~ de03 0.601 0.031 19.538 0.000 0.540 0.661
DE =~ de04 -0.455 0.037 -12.178 0.000 -0.529 -0.382
DE =~ de05 0.522 0.035 15.095 0.000 0.454 0.590
DE =~ de06 0.622 0.030 20.974 0.000 0.563 0.680
DE =~ de07 0.618 0.030 20.741 0.000 0.560 0.677
DE =~ de08 0.690 0.026 26.769 0.000 0.640 0.741
DE =~ de09 0.280 0.043 6.509 0.000 0.196 0.364
DE =~ de10 0.699 0.025 27.660 0.000 0.649 0.748
DE =~ de11 0.198 0.045 4.437 0.000 0.111 0.286
UN =~ un01 0.750 0.021 35.714 0.000 0.709 0.791
UN =~ un02 0.825 0.016 51.916 0.000 0.794 0.857
UN =~ un03 0.552 0.032 17.112 0.000 0.489 0.615
UN =~ un04 0.746 0.021 35.122 0.000 0.705 0.788
UN =~ un05 0.807 0.017 46.861 0.000 0.773 0.840
UN =~ un06 0.432 0.037 11.522 0.000 0.358 0.505
UN =~ un07 0.697 0.024 28.655 0.000 0.649 0.745
UN =~ un08 0.760 0.020 37.374 0.000 0.720 0.800
UN =~ un09 0.700 0.024 28.953 0.000 0.652 0.747
UN =~ un10 0.719 0.023 31.319 0.000 0.674 0.764
UN =~ un11 0.773 0.019 39.708 0.000 0.735 0.811
UN =~ un12 0.744 0.021 34.839 0.000 0.702 0.786

Covariances:


kable(
  smodel1 %>% 
    filter(op == "~~" & lhs != rhs) %>% 
    mutate_at(vars(4:9), function(x) round(x, 3)),
  col.names = c("Factor", "", "Factor", "Covariance", "SE", "z", "p", "CI lower bound", "CI upper bound")
)
Factor Factor Covariance SE z p CI lower bound CI upper bound
PR ~~ CO 0.701 0.030 23.747 0.00 0.643 0.759
PR ~~ UT 0.770 0.024 31.846 0.00 0.722 0.817
PR ~~ FA 0.549 0.038 14.491 0.00 0.475 0.623
PR ~~ DE 0.894 0.018 50.899 0.00 0.859 0.928
PR ~~ UN 0.421 0.041 10.162 0.00 0.340 0.502
CO ~~ UT 0.469 0.040 11.769 0.00 0.391 0.547
CO ~~ FA 0.480 0.041 11.816 0.00 0.400 0.559
CO ~~ DE 0.659 0.032 20.450 0.00 0.596 0.722
CO ~~ UN 0.328 0.044 7.444 0.00 0.242 0.415
UT ~~ FA 0.412 0.042 9.755 0.00 0.329 0.495
UT ~~ DE 0.699 0.029 24.200 0.00 0.642 0.755
UT ~~ UN 0.333 0.043 7.734 0.00 0.248 0.417
FA ~~ DE 0.640 0.034 19.071 0.00 0.574 0.705
FA ~~ UN 0.088 0.049 1.815 0.07 -0.007 0.184
DE ~~ UN 0.409 0.042 9.717 0.00 0.326 0.491

Residuals:


kable(
  smodel1 %>% 
    filter(op == "~~" & lhs == rhs) %>% 
    mutate_at(vars(4:9), function(x) round(x, 3)) %>% 
    select(-(2:3)),
  col.names = c("Item", "Residual", "SE", "z", "p", "CI lower bound", "CI upper bound")
)
Item Residual SE z p CI lower bound CI upper bound
pr01 0.411 0.032 12.942 0 0.349 0.474
pr02 0.638 0.037 17.449 0 0.566 0.710
pr03 0.957 0.018 52.044 0 0.921 0.993
pr04 0.996 0.006 174.276 0 0.985 1.007
pr05 0.669 0.037 18.314 0 0.597 0.740
pr06 0.633 0.037 17.317 0 0.561 0.705
pr07 0.468 0.034 13.900 0 0.402 0.535
pr08 0.467 0.034 13.882 0 0.401 0.533
pr09 0.642 0.037 17.551 0 0.570 0.714
pr10 0.730 0.036 20.422 0 0.660 0.800
co01 0.447 0.034 13.002 0 0.380 0.515
co02 0.507 0.036 14.092 0 0.436 0.577
co03 0.727 0.037 19.882 0 0.655 0.799
co04 0.865 0.030 28.690 0 0.806 0.924
co05 0.393 0.033 12.037 0 0.329 0.457
co06 0.606 0.037 16.203 0 0.533 0.679
co07 0.938 0.022 42.790 0 0.895 0.981
co08 0.861 0.030 28.267 0 0.801 0.920
co09 0.456 0.035 13.151 0 0.388 0.523
co10 0.608 0.037 16.245 0 0.534 0.681
ut01 0.400 0.031 12.912 0 0.340 0.461
ut02 0.299 0.026 11.270 0 0.247 0.350
ut03 0.814 0.033 24.905 0 0.750 0.878
ut04 0.760 0.035 21.825 0 0.692 0.829
ut05 0.561 0.036 15.737 0 0.491 0.631
ut06 0.420 0.032 13.219 0 0.357 0.482
ut07 0.661 0.036 18.151 0 0.589 0.732
ut08 0.584 0.036 16.237 0 0.514 0.655
ut09 0.549 0.035 15.491 0 0.480 0.618
ut10 1.000 0.001 696.420 0 0.997 1.003
ut11 0.717 0.036 19.992 0 0.646 0.787
ut12 0.507 0.035 14.700 0 0.440 0.575
fa01 0.318 0.031 10.172 0 0.256 0.379
fa02 0.871 0.030 29.210 0 0.812 0.929
fa03 0.957 0.019 51.134 0 0.920 0.994
fa04 0.855 0.031 27.568 0 0.794 0.916
fa05 0.278 0.030 9.259 0 0.219 0.337
fa06 0.616 0.038 16.300 0 0.542 0.691
fa07 0.944 0.021 44.524 0 0.902 0.985
fa08 0.883 0.029 30.690 0 0.826 0.939
fa09 0.824 0.033 24.898 0 0.759 0.889
fa10 0.653 0.038 17.275 0 0.579 0.727
de01 0.666 0.037 18.067 0 0.594 0.738
de02 0.509 0.035 14.429 0 0.439 0.578
de03 0.639 0.037 17.319 0 0.567 0.712
de04 0.793 0.034 23.283 0 0.726 0.859
de05 0.728 0.036 20.177 0 0.657 0.798
de06 0.614 0.037 16.662 0 0.542 0.686
de07 0.618 0.037 16.762 0 0.546 0.690
de08 0.524 0.036 14.717 0 0.454 0.593
de09 0.922 0.024 38.260 0 0.874 0.969
de10 0.512 0.035 14.486 0 0.442 0.581
de11 0.961 0.018 54.124 0 0.926 0.995
un01 0.438 0.031 13.890 0 0.376 0.499
un02 0.319 0.026 12.139 0 0.267 0.370
un03 0.695 0.036 19.530 0 0.626 0.765
un04 0.443 0.032 13.978 0 0.381 0.505
un05 0.349 0.028 12.588 0 0.295 0.404
un06 0.814 0.032 25.176 0 0.750 0.877
un07 0.514 0.034 15.159 0 0.448 0.581
un08 0.422 0.031 13.656 0 0.362 0.483
un09 0.510 0.034 15.093 0 0.444 0.577
un10 0.483 0.033 14.616 0 0.418 0.548
un11 0.402 0.030 13.356 0 0.343 0.461
un12 0.446 0.032 14.021 0 0.384 0.508
PR 1.000 0.000 NA NA 1.000 1.000
CO 1.000 0.000 NA NA 1.000 1.000
UT 1.000 0.000 NA NA 1.000 1.000
FA 1.000 0.000 NA NA 1.000 1.000
DE 1.000 0.000 NA NA 1.000 1.000
UN 1.000 0.000 NA NA 1.000 1.000

Visualization:


semPaths(model1, "std")